COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "TEX" comment The TEX processor....
C00006 00003	Error handling procedures: quit,error,backerror,overflow,confusion
C00009 00004	Dynamic memory allocation: links, memsize, varsize, mem, memreal
C00012 00005	Partial field macros: field,ufield,link,info,setfield...setinfo
C00016 00006	Memory allocation procedures: getavail, freeavail, getnode, freenode
C00021 00007	Memory, continued: dslist,delrclink,delgluelink,checkmem,initmem
C00030 00008	Getting the whole thing started properly
C00035 ENDMK
C⊗;
begin "TEX" comment The TEX processor....
	coded by D. E. Knuth
	based in part on a prototype design by M. F. Plass and F. M. Liang.

This processor is in five parts:

1. The present module contains routines for memory management,
	initialization, and external control (getting things
	started and stopped gracefully).
2. The TEXSYN module, compiled separately, contains routines 
	for scanning the input, including such things as the
	expansion of user-defined macros.
3. The TEXSEM module, compiled separately, contains routines
	for building the data structures corresponding to the
	user's source text.
4. The TEXOUT module, compiled separately, contains routines
	for outputting the data structures to a peripheral device.
	(Substitution of a different TEXOUT module will direct
	the output to a different device.)
5. The TEXEXT module, compiled separately, contains extensions
	that some users may decide to write in SAIL. In the
	initial implementation, only a dummy version of TEXEXT
	has been written, but calls to this module have been
	placed at critical points in the control structure.

There is an independently running program TEXPRE which does the preprocessing
necessary to compute the initial values of TEX's hash table, equivalents table,
and hyphenation tables, and which stores them on file TEXINI.TBL. The TEXPRE
program should be consulted for details about the initial contents of these
tables.

Finally, there is also a TEXHDR file which contains all the declarations of
variables used by more than one module.

It is wise to look at the first page of TEXHDR before reading the
following code, since TEXHDR introduces a few abbreviations that are
used throughout the TEX programs;

require "TEXSYN.REL" load_module;
require "TEXSEM.REL" load_module;
require "TEXOUT.REL" load_module;
require "TEXEXT.REL" load_module;
require "TEXHDR.SAI" source_file;

comment To compile TEX with the BAIL debugger, make sure that DEBUGONLY
is defined to be ⊂⊃ in TEXHDR, then do "com texsyn(27b,)" and
"com texsem(27b,)" and "com texout(27b,)" and "com texext(27b,)" and "try texpre"
and finally "try texsys".
To compile TEX without BAIL, make sure that DEBUGONLY is defined to be
⊂comment⊃ in TEXHDR, then do "com texsyn"..."com texext" and "ex texpre" and
"ex texsys";
comment Error handling procedures: quit,error,backerror,overflow,confusion;

label end_of_TEX,final_end;
internal procedure quit # closes output files and terminates TEX;
begin DEBUGONLY bail # when debugging, here's a last chance to see the memory;
go to end_of_TEX;
end;

internal boolean pausing_on_errors # should TEX wait after error messages?;

internal procedure error(string s) # prints an error message;
begin comment String s explains the type of error. This is displayed to the
user and then the current source code position is indicated;
print(nextline,"! ",s,".");
dumpcontext # prints indication of where the scanner is now;
if pausing_on_errors then while true do
	begin integer c;
	print("↑"); c←inchrw;
	if c='15 then begin c←inchrw # ignore the line-feed; return end;
	if c='12 then begin pausing_on_errors←false; return end;
	if c="T" or c="t" then edfile(curfile,curfline,curfpage);
	if c="X" or c="x" then quit;
	DEBUGONLY if c="b" then begin bail; return end;
	print(nextline,"Type <cr> to continue, <lf> to flash error messages,
	t or T to edit, x or X to quit.");
	end;
end;

internal procedure backerror(string s) # error followed by backinput;
begin error(s);
backinput;
end;

internal procedure reportoverflow(string s; integer n)
	# for fatal errors when a TEX table is undersized;
begin pausing_on_errors←false;
error("TEX capacity exceeded, sorry ["&s&"="&cvs(n)&"]");
quit;
end;

internaldef overflow(s)=⊂reportoverflow("s",s)⊃ # specifies inadequate table size;
internal procedure memoverflow; overflow(memsize);

internal procedure confusion # TEX consistency check failure;
begin pausing_on_errors←false;
error("This can't happen");
DEBUGONLY bail;
quit;
end;
comment Dynamic memory allocation: links, memsize, varsize, mem, memreal;

comment TEX does nearly all of its own memory allocation, so that it can
readily be transported into environments which do not have automatic
facilities for strings, garbage collection, etc. The dynamic storage
requirements of TEX are handled by providing a large integer array "mem" 
in which consecutive blocks of words are used as nodes by the TEX routines.
Pointer variables are indices into this array. To use mem[p] as a real
variable instead of as an integer, we write "memreal(p)".

The mem array is divided once and for all into two regions which are allocated
separately. The first varsize locations are used for storing variable-length
records consisting of two or more words. This region is maintained using an
algorithm similar to the one described in exercise 2.5-19 of ACP. However,
no size field appears in the allocated nodes: the program is responsible for
knowing the relevant size when the node is freed. Also, the sign in the first
word of each node is used as a boundary tag by the allocation routines, so
ALL DATA STRUCTURES MUST BE DESIGNED TO ENSURE THAT THE FIRST WORD OF
TWO-OR-MORE-WORD NODES IS NONNEGATIVE. The remaining region of mem is allocated
in single words using a conventional AVAIL stack.
;
internaldef links = 14 # number of bits per pointer;
internaldef memsize=8000 # size of dynamic list memory, must be ≤ 2↑links;
internaldef varsize=2500 # size of variable node memory, must be << memsize;

preload_with 0 # the following array will be initialized upon loading;
internal integer array mem[0:memsize-1] # dynamic list memory;
internaldef memreal(p)=⊂memory[location(mem[p]),real]⊃ # mem[p] as type real;

DEBUGONLY internal integer dynused,varused # how much memory is in use;
comment Partial field macros: field,ufield,link,info,setfield...setinfo;

comment The following macros are for accessing and modifying partial fields
of packed words. If f is a field name, then fs denotes its size in bits
and fd denotes its displacement from the right of the word. These sizes and
displacements are defined at compile time--e.g.,"links" for size of link fields.
In the following definitions, x denotes the word being modified and y denotes
a new value to be inserted into the specified field (it must not be too
large for the field). The definitions look inefficient, but they take
advantage of the fact that SAIL does a lot of local optimization;


internaldef fs(f) = ⊂f⊃&"s" # field size of f, in bits;
internaldef fd(f) = ⊂f⊃&"d" # field displacement of f, in bits;

internaldef field(f,x) = ⊂ifc fd(f)=0 thenc ((x) land (2↑fs(f)-1))
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc ((x) lsh -fd(f))
	elsec (((x) lsh -fd(f)) land (2↑fs(f)-1)) endc endc⊃ # field f of x;

internaldef setfield(f,x,y) = ⊂ifc fd(f)=0 thenc x←(x land(-2↑fs(f)))+(y)
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc 
		x←((x lsh(bitsperwd-fd(f)))+(y))rot fd(f)
	elsec x←(((x rot -fd(f))land(-2↑fs(f)))+(y))rot fd(f) endc endc⊃
		# sets field f of x equal to y, 0 ≤ y < 2↑fs(f);

comment Sometimes an unshifted field is desired. For this purpose, we use
ufield instead of field, and deal with values times 2↑fd;

internaldef ufield(f,x) = ⊂((x) land((1 lsh(fs(f)+fd(f)))-2↑fd(f)))⊃
		# unshifted field f of x;
internaldef setufield(f,x,y) = ⊂x←(x land lnot((1 lsh(fs(f)+fd(f)))-2↑fd(f)))+(y)⊃
		# field f of x set to unshifted value y;

comment The special case of a pointer field at the right of a word is
most common, so there are special conventions for it. When p is a pointer,
we write link(p) for the pointer field of mem[p] and info(p) for the
(shifted) remaining fields of the word;

internaldef linkd = 0 # displacement of link field;
internaldef link(p) = ⊂field(link,mem[p])⊃ # link field of mem[p];
internaldef setlink(p,y) = ⊂setfield(link,mem[p],y)⊃ # sets link(p)←y;
internaldef infod = links, infos = bitsperwd-infod # definition of info field;
internaldef info(p) = ⊂field(info,mem[p])⊃ # info field of mem[p];
internaldef setinfo(p,y) = ⊂setfield(info,mem[p],y)⊃ # sets info(p)←y;

DEBUGONLY integer procedure lk(integer x);
DEBUGONLY return(x land(2↑links-1)) # link field of packed word;
DEBUGONLY integer procedure fo(integer x);
DEBUGONLY return(x lsh -infod) # info field of packed word;
comment Memory allocation procedures: getavail, freeavail, getnode, freenode;

comment	getavail(p) makes p point to a new one-word node,
	freeavail(p) returns it to storage.
	p←getnode(s) makes p point to a new s-word node and clears mem[p] to zero,
	freenode(p,s) will return this node to storage.
;
internal integer avail # head of available space list for one-word nodes;
internaldef getavail(p) = ⊂begin if(p←avail)then avail←mem[avail]
	else memoverflow: DEBUGONLY dynused←dynused+1: end⊃ # p ← new node;
internaldef freeavail(p) = ⊂begin mem[p]←avail: avail←p:
	DEBUGONLY dynused←dynused-1: end⊃ # node p now available;

comment The available space list for variable-size nodes is a nonempty,
doubly-linked circular list, pointed to by the roving pointer "rover". 
The second word of each entry contains the size (which is always ≥2), while
the first word contains the llink and rlink and a minus sign;

integer rover # pointer into double-avail list;
define nodesize(p) = ⊂mem[p+1]⊃;
define llinks = links, llinkd = infod # definition of llink field;

internal integer procedure getnode(integer size) # variable-size node allocation;
begin comment returns a pointer to a new node of the specified size,
which must be 2 or more. All words of the new node are set to zero;
integer p,q,s,t,u;
label ovfl, found;
comment The following tricky code does
	llink(rlink(p))←llink(p), rlink(llink(p))←rlink(p);
define removenode(p)=
	⊂begin if p=rover then
		begin rover←link(p);
		if p=rover then go to ovfl # list musn't become empty;
		end;
	u←((p lsh llinkd) + p) xor mem[p] # bits to change;
	t←field(llink,mem[p]) # llink(p);
	mem[t]←field(link,u) xor mem[t];
	t←link(p) # rlink(p);
	mem[t]←ufield(llink,u) xor mem[t];
	end⊃;
p←rover;
do	begin q←p+nodesize(p) # q points past the end of node(p);
	while mem[q]<0 do
		begin comment merge with the next node, if it is free too;
		removenode(q); q←q+nodesize(q);
		end;
	if (s←q-p) ≥ size+2 then
		begin q←q-size # allocate from top end;
		nodesize(p)←q-p # remaining free area size;
		rover ← p # let rover rove around;
		go to found;
		end;
	if s = size then
		begin removenode(p) # exact fit, now t = rlink(p);
		rover ← t # let rover rove;
		q ← p; go to found;
		end;
	nodesize(p)←s # reset the node size in case it grew;
	p←link(p);
	end until p=rover # repeat until whole list traversed;
ovfl: overflow(varsize) # no large enough space was found;
found: for p ← q thru q+size-1 do mem[p]←0 # clear out the node found;
DEBUGONLY varused←varused+size;
return(q) # deliver the goods;
end;

internal procedure freenode(integer p,size) # variable-size node liberation;
begin comment The node of length "size" starting at mem[p] is made available
to the variable-node storage pool, by inserting it into the double-avail
list just before where rover now points. We must have size ≥ 2;
integer q;
q←field(llink,mem[rover]) # llink(rover);
setlink(q,p); setfield(llink,mem[rover],p);
mem[p]←(q lsh llinkd)+rover+(1 lsh(bitsperwd-1)) # now p is linked into the circle;
DEBUGONLY varused←varused-size;
nodesize(p)←size;
end;
comment Memory, continued: dslist,delrclink,delgluelink,checkmem,initmem;

internal procedure dslist(integer p) # makes list of 1-word nodes available;
begin comment The linked list of single-word nodes pointed to by p is freed;
integer q;
while p do
	begin q←link(p); freeavail(p); p←q;
	end;
end;

internaldef refct1 = 1 lsh infod # 1 in the information (reference count) field;

internal simple procedure delrclink(integer p) # remove ptr to list with ref ct;
begin comment info(p) is a reference count which is to be decreased by 1.
If the result is negative, the linked list of single-word nodes pointed to by p
is freed;
if(mem[p]←mem[p]-refct1)<0 then dslist(p);
end;

internal simple procedure delgluelink(integer p) # remove pointer to glue node;
begin comment info(p) is a reference count which is to be decreased by 1.
If the result is negative, node(p) (which has "gluespecsize" words) is freed;
if(mem[p]←mem[p]-refct1)<0 then freenode(p,gluespecsize);
comment In this case it's OK to let the first word of the node go negative;
end;

DEBUGONLY preload_with 0; DEBUGONLY integer array free[0:memsize-1];
DEBUGONLY procedure checkmem(boolean printlocs) # checks the free areas of mem;
DEBUGONLY begin comment This procedure checks the format of the available space
DEBUGONLY lists and (if printllocs is true) prints those locations of mem that were
DEBUGONLY free the last time this procedure was called but reserved now.
DEBUGONLY All nodes should be returned to the avail lists when TEX is done with
DEBUGONLY them, and checkmem can be used to check if this has been done correctly;
DEBUGONLY integer p,i; label printout;
DEBUGONLY p←avail;
DEBUGONLY while p do
DEBUGONLY 	begin if (free[p] land 1) or mem[p]≥memsize or
DEBUGONLY		(mem[p]≠0 and mem[p]≤varsize) then
DEBUGONLY 		begin print(nextline,"avail list clobbered at ",p);
DEBUGONLY		done;
DEBUGONLY 		end;
DEBUGONLY 	free[p]←free[p] lor 1;
DEBUGONLY 	p←mem[p];
DEBUGONLY 	end;
DEBUGONLY p←rover;
DEBUGONLY do	begin
DEBUGONLY 	if p≥varsize or p≤0 or mem[p]≥0 or p+nodesize(p)>varsize or
DEBUGONLY 	nodesize(p)<2 or field(llink,mem[link(p)])≠p then
DEBUGONLY 		begin print(nextline,"double-avail list clobbered at ",p);
DEBUGONLY		done;
DEBUGONLY 		end;
DEBUGONLY 	for i←p thru p+nodesize(p)-1 do
DEBUGONLY 		begin if free[i] land 1 then
DEBUGONLY 			begin print(nextline,"doubly free location at ",i);
DEBUGONLY 			go to printout;
DEBUGONLY 			end;
DEBUGONLY 		free[i]←free[i] lor 1;
DEBUGONLY 		end;
DEBUGONLY 	p←link(p);
DEBUGONLY 	end until p=rover;
DEBUGONLY printout: if printlocs then print(nextline,"New busy locs: ");
DEBUGONLY for i←0 thru memsize-1 do
DEBUGONLY 	begin if free[i] land 3 = 2 and printlocs then print(i," ");
DEBUGONLY 	free[i]←free[i] lsh 1;
DEBUGONLY 	end;
DEBUGONLY end;

comment Some areas of mem are dedicated to fixed usage. For example, the
list heads "pagehead" and "pagecontrib" of the page builder are assigned
to fixed memory locations. (Since mem[pagecontrib] will never be
negative, we define pagecontrib=varsize, then the getfree procedure will
never try to combine the one-word memory with a variable-size free node.)
The special glue used in \hfill and \vfill is kept in a fixed place, as
are the heads of alignrecord lists. Only locations mem[firstmem] thru
mem[varsize-1] are actually allocatable for variable-size memory, 
and mem[secondmem] thru mem[memsize-1] for one-word memory.
;
internaldef fillglue=0 # location of glue specification 0pt plus 10↑10 pt;
internaldef lowerfillglue=gluespecsize # loc of glue specification
		0pt plus 10↑6pt minus 10↑6 pt;
internaldef zeroglue=lowerfillglue+gluespecsize # loc of glue specification 0pt;
internaldef firstmem=zeroglue+gluespecsize # location of 
		first usable mem word, must be >0;
internaldef waitinghead=varsize # head of list of inserts too big for current page;
internaldef contribhead=waitinghead+1 # head of contribution vlist for current page;
internaldef pagehead=pagecontrib+1 # head of vlist for current page;
internaldef temphead=pagehead+1 # temporary head of a miscellaneous list;
internaldef holdhead=temphead+1 # temporary head of another miscellaneous list;
internaldef alignhead=holdhead+1 # alignhead+j is head of jth alignrecordlist;
internaldef inserts=alignhead+alignsize # head of insert list returned by packager;
internaldef hsizemem=inserts+1 # location where current hsize is stored;
internaldef vsizemem=hsizemem+1 # location where current vsize is stored;
internaldef maxdepthmem=vsizemem+1 # location where current maxdepth is stored;
internaldef parindentmem=maxdepthmem+1 # location where current parindent is stored;
internaldef secondmem=parindentmem+1 # first usable mem word in 1-word area;

internal procedure initmem # initializes the memory system;
begin integer i;
for i←secondmem thru memsize-2 do mem[i+1]←i;
mem[secondmem]←0; avail←memsize-1 # now the avail stack is initialized;

mem[firstmem]←(firstmem lsh llinkd)+firstmem+(1 lsh(bitsperwd-1));
nodesize(firstmem)←varsize-firstmem # one node in the circle;
rover←firstmem # rover points to it, now the double-avail list is initialized;

for i←0 thru firstmem-1 do mem[i]←0;
for i←varsize thru secondmem-1 do mem[i]←0;
end;
comment Getting the whole thing started properly;

preload_with true; boolean array notalreadyinitialized[0:0];

comment The declarations have now ended, TEX starts here after being loaded;
if notalreadyinitialized[0] then
	begin integer chan;
	notalreadyinitialized[0]←false;
	initmem # initialize the mem array, this should be done first;
	gluestretch(fillglue)←10000000000.0 # initialize the fillglue;
	gluestretch(lowerfillglue)←glueshrink(lowerfillglue)←1000000.0;
	mem[zeroglue]←mem[lowerfillglue]←mem[fillglue]←
		1000000 lsh infod # "infinite" reference count;
	memreal(hsizemem)←4.5*72.0 # default hsize is about 4.5 inches;
	memreal(vsizemem)←7.0*72.0 # default vsize is about 7.0 inches;
	memreal(maxdepthmem)←2.0  # default maxdepth is 3.0 points;
	comment The default value of parindent is 0.0;
	initsftable(3.0,3.0,3.0,2.0,1.5,1.25) # initialize the spacefactor table;
	mathfonttable[0]←mathfonttable[1]←mathfonttable[2]←mathfonttable[3]←-1;
	tracing←0; jpar←2 # standard parameter settings;

	open(chan←getchan,"DSK",'10,2,0,0,0,eof);
	lookup(chan,"TEXINI.TBL",eof);
	if eof or wordin(chan)≠hashsize or wordin(chan)≠locsize or
		wordin(chan)≠excepsize or wordin(chan)≠sufsize or
		wordin(chan)≠prefsize or wordin(chan)≠btabsize then
		begin print("TEXINI.TBL is clobbered!"); go to final_end;
		comment If this error happens, execute TEXPRE to rewrite the file;
		end;
	arryin(chan,hash[0],hashsize);
	arryin(chan,eqtb[0],hashsize+256);
	arryin(chan,locs[0],locsize);
	arryin(chan,exceptable[0],excepsize);
	arryin(chan,excephyph[1],excepsize-1);
	arryin(chan,suffix[0],sufsize);
	arryin(chan,prefix[0],prefsize);
	arryin(chan,btable[2],btabsize);
	arryin(chan,delimtable[0],128);
	release(chan);

	pausing_on_errors←true;

	outstr("TEX's tables have been initialized. 
	Either hit CALL and .SAVE TEX for future RUNning,
	or type <cr> to go on.");
	if inchwl then;
	end;
initext # initialize the extensions if any;
initsave # initialize the save-restore mechanism;
setformat(0,4) # controls format of cvf in diagnostic routine "dumpnodelist";
setprint("errors.tmp","B") # printing goes to file as well as terminal;
DEBUGONLY dynused←varused←0;
initin # initialize the input system;
initout # initialize the output system;
fmemptr←0 # initialize the secondary font memory;
maincontrol # transfer power to the chief executive;

end_of_TEX: closeout # close output files of TEXOUT;
setprint("errors.tmp","N") # close print output file;
finishext # do any closing actions desired by extensions;
final_end: end "TEX"